home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / manchest.lha / MANCHESTER / manchester / 4.1 / grapher.st < prev    next >
Text File  |  1993-07-24  |  42KB  |  1,189 lines
  1. "    NAME        grapher
  2.     AUTHOR        miw@cs.man.ac.uk (Mario Wolczko)
  3.     FUNCTION    a graphing tool
  4.     ST-VERSION    4.1
  5.     PREREQUISITES    ComponentView SimpleBorderedWrapper PluggableControllerWithMenu graphs CachingWrapper PanningWrapper
  6.     CONFLICTS    
  7.     DISTRIBUTION    world
  8.     VERSION        2.1
  9.     DATE        30 July 1992
  10. SUMMARY This is a port of the second release of a graphing tool 
  11. based loosely on the grapher written for version 2 of Smalltalk by 
  12. Steve Messick and Chris Jacobson of Tektronix.  
  13. The code is a complete rewrite and redesign for Smalltalk Release 4.  
  14. It provides a number of new features:
  15.  - a general representation for graphs (graphs.st)
  16.  - the ability to use different algorithms for layout (simple
  17.    algorithms for DAGs and trees [forests, actually] are provided)
  18. and lots, lots more pluggability and parameterisability.
  19. See the examples in GraphView. 'Compatibility' methods with the old
  20. grapher are provided, requiring only the change of class name before
  21. the new grapher can be used.
  22.  
  23. Numerous things remain to be done:
  24.  - a proper user manual
  25.  - more sophisticated layout algorithms
  26.  - editing of graph layouts
  27.  - output to PostScript
  28.  - layout of undirected graphs and graphs with cycles
  29.  
  30. To file in the whole package, do this:
  31.   #('ComponentView.st'
  32.   'SimpleBorderedWrapper.st'
  33.   'PluggableControllerWithMenu.st'
  34.   'collections-misc.st'
  35.   'Iterator.st'
  36.   'graphs.st'
  37.   'CachingWrapper.st'
  38.   'PanningWrapper.st'
  39.   'grapher.st')
  40.     do: [ :f | (Filename named: ""'grapher/',""f) fileIn]
  41.  
  42. Comments, etc, welcome.
  43.  
  44. Thanks go to numerous people for suggestions and bug reports: Ron
  45. Ferguson, Trevor Hopkins, Joachim Geidel, Frerk Meyer,
  46. Ian Piumarta, Deepak Sharma, Darrin Smart, and Jon Sticklen.
  47.  
  48. Special thanks to Bernard Horan for doing the initial port to 4.1
  49.  
  50. Mario Wolczko
  51.  
  52. Dept. of Computer Science   Internet:      mario@cs.man.ac.uk
  53. The University              uucp:        uknet!!man.cs!!mario
  54. Manchester M13 9PL          JANET:         mario@uk.ac.man.cs
  55. U.K.                        Tel: +44-61-275 6146  (FAX: 6236)
  56. ______the mushroom project___________________________________
  57.  
  58. "
  59. Object subclass: #GraphComposer
  60.     instanceVariableNames: ''
  61.     classVariableNames: ''
  62.     poolDictionaries: ''
  63.     category: 'Tools-Grapher'!
  64. GraphComposer comment:
  65. 'GraphComposer is the abstract superclass of classes that can compose a graph of views for presentation by a GraphView.'!
  66.  
  67.  
  68. !GraphComposer methodsFor: 'composing'!
  69.  
  70. compose
  71.     self subclassResponsibility! !
  72.  
  73. !GraphComposer methodsFor: 'accessing'!
  74.  
  75. graphExtent
  76.     "Return the size of the composed graph."
  77.     self subclassResponsibility!
  78.  
  79. linesDo: aBlock
  80.     "Evaluate aBlock for each line's start and end point, and label."
  81.     self subclassResponsibility!
  82.  
  83. nodesAndPositionsDo: aBlock
  84.     "Evaluate aBlock for each node in the graph and its position."
  85.     self subclassResponsibility!
  86.  
  87. nodeViewsAndPositionsDo: aBlock
  88.     "Evaluate aBlock for each node's view in the graph and its position."
  89.     self subclassResponsibility! !
  90.  
  91. GraphComposer subclass: #AbstractDAGComposer
  92.     instanceVariableNames: 'graph views leafMargin rootMargin sideMargin horizontal minPCspace minSiblingSpace positions graphExtent lines extents extentBlock inBlock outBlock labels labelPositions labelPositionBlock '
  93.     classVariableNames: ''
  94.     poolDictionaries: ''
  95.     category: 'Tools-Grapher'!
  96. AbstractDAGComposer comment:
  97. 'AbstractDAGComposer provides most of the protocol to lay out DAGs.  The actual layout algorithm must be provided by a subclass (positionNodes).
  98.  
  99. To use it:
  100.     - First, initialize (set up graph & extentBlock, optionally: margins, direction (horizontal/vertical), spacings)
  101.     - Then, you can set up connection blocks (setting direction overwrites this)
  102.     - Then compose the graph,
  103.     - Finally, you can access the positions of the nodes and lines.
  104.  
  105. Some possible improvements:
  106.     - Allow reversed graphs (roots at right or bottom)
  107.     - Better layout (improved depth weighting)
  108.     - protocol to specify order of roots
  109.  
  110. Instance variables:
  111.     graph        - The <RootedGraph> being composed.
  112.     views        - A Dictionary from nodes in the RootedGraph to views (VisualComponents)
  113.     leafMargin    - <Integer> the amount of space to leave at the left of the composition
  114.     rootMargin    - <Integer> the amount of space to leave between the roots and the edge
  115.     sideMargin    - <Integer> the amount of space to leave at the sides of the graph
  116.     horizontal    - <Boolean> true if the layout is horizontal (roots at left), false if vertical (roots at top)
  117.     minPCspace - <Integer> the minimum spacing between parents and children in the layout
  118.     minSiblingSpace - <Integer> the minimum spacing between siblings
  119.     positions    - A Dictionary from nodes in the graph to the positions of their views (Points) in the layout
  120.     graphExtent - A <Point> representing the extent of the composed graph
  121.     lines        - An <OrderedCollection of: Array> where each Array has three elements:
  122.                     1. Start <Point>  2. End <Point>  3. <Object|nil> representation of the label for that edge.
  123.     extents        - A <Dictionary> mapping graph nodes to the extents of their views
  124.     extentBlock    - A block that takes a node''s view and returns the view''s extent
  125.     inBlock        - A block that, given the views at the end and start of an edge, and the bounding box of the former, returns a suitable end <Point> for the edge
  126.     outBlock    - As above, but returns a start <Point>
  127.     labels        - A <Dictionary> mapping an Array of (start node, end node, label) for each edge to the object 
  128. representing the label on the edge
  129.     labelPositions - A <Dictionary> from labels to positions
  130.     labelPositionBlock    - A block that given the start and end <Points> of each edge, and the label for that edge, returns a <Point> describing where the label should be positioned.
  131.     '!
  132.  
  133.  
  134. !AbstractDAGComposer methodsFor: 'initialization'!
  135.  
  136. centeredTextLabels
  137.     "Set label positioning to center on line."
  138.  
  139.     labelPositionBlock :=
  140.         [ :start :end :label || extent |
  141.             extent := label extent.
  142.             (start + end - extent) // 2]!
  143.  
  144. extentBlock: e
  145.     extentBlock := e!
  146.  
  147. graph: g
  148.     graph := g!
  149.  
  150. horizontal
  151.     horizontal := true.
  152.     self initializeConnectionBlocks!
  153.  
  154. initialize
  155.     sideMargin := 10.
  156.     leafMargin := 10.
  157.     rootMargin := 10.
  158.     minPCspace := 10.
  159.     minSiblingSpace := 10.
  160.     horizontal := true.
  161.     self initializeConnectionBlocks!
  162.  
  163. labels: labelMap
  164.     labels := labelMap!
  165.  
  166. leafMargin: t
  167.     "Minimum space between leaves and frame."
  168.     leafMargin := t!
  169.  
  170. margins: m
  171.     sideMargin := m.
  172.     leafMargin := m.
  173.     rootMargin := m!
  174.  
  175. minParentChildSpacing: s
  176.     minPCspace := s!
  177.  
  178. minSiblingSpacing: s
  179.     minSiblingSpace := s!
  180.  
  181. orientation: symbol
  182.     horizontal := symbol == #horizontal.
  183.     self initializeConnectionBlocks!
  184.  
  185. rootMargin: t
  186.     "Space between roots and frame."
  187.     rootMargin := t!
  188.  
  189. sideMargin: t
  190.     "Minimum space between nodes and sides of frame (not leaf or root sides)."
  191.     sideMargin := t!
  192.  
  193. vertical
  194.     horizontal := false.
  195.     self initializeConnectionBlocks!
  196.  
  197. views: map
  198.     views := map! !
  199.  
  200. !AbstractDAGComposer methodsFor: 'initialization-connections'!
  201.  
  202. inBlock: aBlock
  203.     "This block can be used to calculate the end point of an edge entering a node.
  204.     The block will be passed:
  205.         1 the view of the node at the end of the edge
  206.         2 the view of the node at the start of the edge
  207.         3 the extent of the bounding box of node 1.
  208.     See initializeConnectionBlocks for example.  Note that the extent is transposed if the graph is vertical."
  209.     inBlock := aBlock!
  210.  
  211. outBlock: aBlock
  212.     "This block can be used to calculate the start point of an edge leaving a node.
  213.     The block will be passed:
  214.         1 the view of the node at the start of the edge
  215.         2 the view of the node at the end of the edge
  216.         3 the extent of the bounding box of node 1.
  217.     See initializeConnectionBlocks for example.  Note that the extent is transposed if the graph is vertical."
  218.     outBlock := aBlock! !
  219.  
  220. !AbstractDAGComposer methodsFor: 'composing'!
  221.  
  222. compose
  223.     "Before composing you must supply:
  224.         graph
  225.         extentBlock
  226.     Other items have default values."
  227.     Cursor wait showWhile:
  228.         [self positionNodes.
  229.         self positionLines.
  230.         self positionLabels]! !
  231.  
  232. !AbstractDAGComposer methodsFor: 'accessing'!
  233.  
  234. graphExtent
  235.     ^graphExtent!
  236.  
  237. labelsAndPositionsDo: aBlock
  238.     "Evaluate aBlock for each label in the graph and its position."
  239.     labelPositions keysAndValuesDo: aBlock!
  240.  
  241. linesDo: aBlock
  242.     "Evaluate aBlock for each line's start and end point, and label (nil if none)."
  243.     lines do: [ :line | aBlock valueWithArguments: line]!
  244.  
  245. nodesAndPositionsDo: aBlock
  246.     "Evaluate aBlock for each node in the graph and its position."
  247.     positions keysAndValuesDo: aBlock!
  248.  
  249. nodeViewsAndPositionsDo: aBlock
  250.     "Evaluate aBlock for each node in the graph and its position."
  251.     positions keysAndValuesDo: [ :node :position |
  252.         aBlock value: (views at: node value) value: position]! !
  253.  
  254. !AbstractDAGComposer methodsFor: 'private'!
  255.  
  256. initializeConnectionBlocks
  257.     horizontal
  258.         ifTrue:
  259.             [inBlock := [ :node :pred :extent | 0@(extent y * 0.5)].
  260.             outBlock := [ :node :succ :extent | (extent x)@(extent y * 0.5)]]
  261.         ifFalse:
  262.             [inBlock := [ :node :pred :extent | (extent y * 0.5)@0].
  263.             outBlock := [ :node :succ :extent | (extent y * 0.5)@(extent x)]]!
  264.  
  265. leafMargin
  266.     ^leafMargin!
  267.  
  268. minParentChildSpacing
  269.     ^minPCspace!
  270.  
  271. minSiblingSpacing
  272.     ^minSiblingSpace!
  273.  
  274. rootMargin
  275.     ^rootMargin!
  276.  
  277. sideMargin
  278.     ^sideMargin! !
  279.  
  280. !AbstractDAGComposer methodsFor: 'private-composing'!
  281.  
  282. buildExtents
  283.     "extents will cache the maximum extent of a node in the plane."
  284.     | eBlock |
  285.     eBlock := horizontal
  286.                 ifTrue: [[ :node | extentBlock value: (views at: node value)]] 
  287.                 ifFalse: [[ :node | (extentBlock value: (views at: node value)) transpose]].
  288.     extents := DictionaryWithDefault newWithDefaultValueBlock: eBlock!
  289.  
  290. positionLabels
  291.     "Having placed the nodes and lines, now place the labels."
  292.     labelPositions := Dictionary new.
  293.     labelPositionBlock isNil ifTrue: [^self].    "no labels wanted"
  294.     self linesDo: [ :start :end :label |
  295.         label notNil
  296.             ifTrue: [labelPositions at: label put: (labelPositionBlock value: start value: end value: label)]]!
  297.  
  298. positionLines
  299.     "Having placed the nodes, now calculate the lines' endpoints."
  300.     lines := OrderedCollection new.
  301.     self nodesAndPositionsDo: [ :node :position || nodeView |
  302.         nodeView := views at: node value.
  303.         node neighborsAndLabelsDo: [ :succ : label || start end succView labelView |
  304.             succView := views at: succ value.
  305.             start := position 
  306.                     + (outBlock value: nodeView value: succView value: (extents at: node)).
  307.             end := (positions at: succ)
  308.                     + (inBlock value: succView value: nodeView value: (extents at: succ)).
  309.             labelView := label isNil ifFalse: [labels at: (Array with: node with: succ with: label)].
  310.             lines add:
  311.                 (Array with: start with: end with: labelView)]]!
  312.  
  313. positionNodes
  314.     "Calculate the positions of the nodes in the graph."
  315.     self subclassResponsibility! !
  316.  
  317. !AbstractDAGComposer methodsFor: 'testing'!
  318.  
  319. orientation
  320.     ^horizontal ifTrue: [#horizontal] ifFalse: [#vertical]! !
  321. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  322.  
  323. AbstractDAGComposer class
  324.     instanceVariableNames: ''!
  325.  
  326.  
  327. !AbstractDAGComposer class methodsFor: 'instance creation'!
  328.  
  329. new
  330.     ^super new initialize! !
  331.  
  332. AbstractDAGComposer subclass: #TreeComposer
  333.     instanceVariableNames: ''
  334.     classVariableNames: ''
  335.     poolDictionaries: ''
  336.     category: 'Tools-Grapher'!
  337. TreeComposer comment:
  338. 'A TreeComposer can lay out a tree.
  339.  
  340. The layout algorithm is simple, based on bounding boxes of sub-trees:
  341.     - the bounding box of a leaf is that of its view
  342.     - the bounding box of a sub-tree is obtained by laying out its sub-trees next to each other, then placing the node at the root of the subtree above those, centered.
  343. '!
  344.  
  345.  
  346. !TreeComposer methodsFor: 'private-composing'!
  347.  
  348. boundingBoxes
  349.     "The default bounding box of a subtree is the extent of the root of the subtree (which is correct for leaves, and will be fixed..."
  350.     | bb |
  351.     bb := DictionaryWithDefault newWithDefaultValueBlock: [ :node | extents at: node].
  352.  
  353.     "...calculate bounding boxes of non-leaves."
  354.     graph walkPre: [ :junk ] post: [ :node |
  355.         node isLeaf
  356.             ifFalse: [| h w ne |
  357.                     h := w := 0.
  358.                     node neighborsDo:
  359.                         [ :child || bbc |
  360.                             bbc := bb at: child.
  361.                             h := h + bbc y + self minSiblingSpacing.
  362.                             w := w max: bbc x].
  363.                     ne := extents at: node.
  364.                     h := (h - self minSiblingSpacing) max: ne y.
  365.                     w := w + ne x + self minParentChildSpacing.
  366.                     bb at: node put: w@h]].
  367.  
  368.     ^bb!
  369.  
  370. offsetsFromParentBB: bbMap
  371.     "Calculate the offset of each node from its parent's subtree's bounding box, given the bounding box of each subtree."
  372.     | offset |
  373.     offset := Dictionary new.
  374.     graph walkPre: [ :junk ] post:
  375.         [ :node |
  376.             node isLeaf
  377.                 ifFalse: [| x y |
  378.                         x := (extents at: node) x + self minParentChildSpacing.
  379.                         y := 0.
  380.                         node neighborsDo:
  381.                             [ :child |
  382.                                 offset at: child put: x@y.
  383.                                 y := y + (bbMap at: child) y + self minSiblingSpacing]]].
  384.     ^offset!
  385.  
  386. positionFromOffsets: offsets boundingBoxes: bb
  387.     | x y maxX |
  388.     positions := Dictionary new.
  389.  
  390.     "set up position(s) of root(s)."
  391.     x := self rootMargin.
  392.     y := self sideMargin.
  393.     maxX := 0.
  394.     graph rootNodes do: [ :root |
  395.         positions at: root put: x@y.    "remember where the last one is."
  396.         y := y + (bb at: root) y + self minSiblingSpacing.
  397.         maxX := maxX max: (bb at: root) x].
  398.     
  399.     graph
  400.         walkPre:    "first pass calculates the position of each bounding box"
  401.             [ :node |
  402.                 node neighborsDo: [ :child |
  403.                     positions at: child put: (positions at: node) + (offsets at: child)]]
  404.          post:         "now adjust for the nodes"
  405.              [ :node |
  406.                  node isLeaf
  407.                      ifFalse: [positions at: node replace:
  408.                                  [ :old | old + (0@((bb at: node) y - (extents at: node) y / 2) rounded)]]].
  409.     horizontal
  410.         ifFalse:
  411.             [positions keysDo: [ :node | positions at: node replace: [ :old | old transpose]]].
  412.  
  413.     "return the extent"
  414.     ^(self rootMargin + maxX + self leafMargin) @ (y - self minSiblingSpacing + self sideMargin)!
  415.  
  416. positionNodes
  417.     "Calculate the positions of the nodes in the graph."
  418.     | bb orp |
  419.     self buildExtents.
  420.     bb := self boundingBoxes.  
  421.     orp := self offsetsFromParentBB: bb.
  422.     graphExtent := self positionFromOffsets: orp boundingBoxes: bb.
  423.     horizontal ifFalse: [graphExtent := graphExtent transpose]! !
  424.  
  425. AbstractDAGComposer subclass: #DAGComposer
  426.     instanceVariableNames: ''
  427.     classVariableNames: ''
  428.     poolDictionaries: ''
  429.     category: 'Tools-Grapher'!
  430. DAGComposer comment:
  431. 'A DAGComposer can lay out DAGs.  It uses a simple-minded algorithm: each node has its depth calculated (the maximum path length from a root), and then all the nodes with the saem depth are layed out next to each other.  A simple heuristic tries to keep nodes below their parents.'!
  432.  
  433.  
  434. !DAGComposer methodsFor: 'private-composing'!
  435.  
  436. nodeOrdering
  437.     "This method lays out the nodes into rows.  All nodes at the same depth in the DAG are on the same row.  The ordering within a row is determined by 'closeness' to predecessors."
  438.     | dl depths weights roots inc p rootList i |
  439.     "First partition the graph into sets of nodes at the same depth."
  440.     dl := graph depthList.
  441.  
  442.     "Next build a map from nodes to depths."
  443.     depths := Dictionary new.
  444.     1 to: dl size do: [ :depth |
  445.         (dl at: depth) do: [ :node |
  446.             depths at: node put: depth]].
  447.  
  448.     "The rest of the method calculates the ordering of nodes at a particular depth.
  449.     To do this, it weights each node with the sum of the weights of its immediate predecessors, and then orders by weight.
  450.     When weighting a node, this particular implementation only considers predecessors with depth one less than the node (should be fixed)."
  451.     weights := DictionaryWithDefault newWithDefaultValue: 0.0.
  452.  
  453.     "First order the roots (nodes with depth 1).  This uses the ordering supplied by the graph."
  454.     roots := graph rootNodes.
  455.     p := inc := (roots size + 1.0) reciprocal.
  456.     rootList := Array new: roots size.
  457.     i := 1.
  458.     graph rootNodes do: [ :n |
  459.         weights at: n put: p.  p := p + inc.
  460.         rootList at: i put: n.  i := i + 1].
  461.     dl at: 1 put: rootList.
  462.  
  463.     "Next weight each node at each depth based on the weights of the predecessors."
  464.     1 to: dl size - 1 do: [ :depth || dld |
  465.         dld := dl at: depth.
  466.         1 to: dld size do: [ :li || node |
  467.             node := dld at: li.
  468.             node neighborsDo: [ :succ |
  469.                 (depths at: succ) = (depth + 1)
  470.                     ifTrue: [weights at: succ replace: [ :old | old + li]]]].
  471.         dl at: depth + 1 replace: [ :dln || sc max |
  472.             "The weights are normalised to be in the range (0,1)."
  473.             max := dln inject: 0.0 into: [ :maxSoFar :n | maxSoFar max: (weights at: n)].
  474.             dln do: [ :n | weights at: n replace: [ :old | old / max]].
  475.             "Sort by weight."
  476.             sc := SortedCollection sortBlock: [ :x :y | (weights at: x) <= (weights at: y)].
  477.             sc addAll: dln.
  478.             sc asArray]].
  479.  
  480.     ^dl!
  481.  
  482. positionNodes
  483.     "Calculate the positions of the nodes in the graph."
  484.     | dl heights widths maxH maxItems startX extraYspace |
  485.     "First work out the breakdown into 'rows' and 'columns'."
  486.     dl := self nodeOrdering.
  487.  
  488.     self buildExtents.
  489.  
  490.     "Calculate the height and maximum width of each column (imagine left-to-right layout)."
  491.     heights := Array new: dl size.
  492.     widths := Array new: dl size.
  493.     1 to: dl size do: [ :depth || totalH maxW |
  494.         totalH := maxW := 0.
  495.         (dl at: depth) do: [ :v || extent |
  496.             extent := (extents at: v).
  497.             totalH := totalH + extent y.
  498.             maxW := maxW max: extent x].
  499.         heights at: depth put: totalH.
  500.         widths at: depth put: maxW].
  501.     
  502.     "Now calculate the maximum height and number of items in the highest column.
  503.     If there is more than column of the maximum height, take the highest number of items found."
  504.     maxH := 0.  maxItems := 0.
  505.     1 to: dl size do: [ :depth || thisH |
  506.         thisH := heights at: depth.
  507.         thisH > maxH ifTrue: [maxH := thisH.  maxItems := (dl at: depth) size].
  508.         thisH = maxH ifTrue: [maxItems := maxItems max: (dl at: depth) size]].
  509.  
  510.     "At last we can position each node.  Space is distributed evenly amongst nodes."
  511.     positions := Dictionary new.
  512.     extraYspace := (maxItems - 1) * self minSiblingSpacing.
  513.     maxH := maxH + extraYspace.
  514.     startX := self rootMargin.
  515.     1 to: dl size do: [ :depth || nodes yInc startY |
  516.         nodes := dl at: depth.
  517.         yInc := (maxH - (heights at: depth)) / nodes size.
  518.         startY := self sideMargin + (yInc * 0.5).
  519.         nodes do: [ :node || pos |
  520.             pos := (startX @ startY) rounded.
  521.             horizontal ifFalse: [pos := pos transpose].
  522.             positions at: node put: pos.
  523.             startY := startY + yInc + (extents at: node) y].
  524.         startX := startX + (widths at: depth) + self minParentChildSpacing].
  525.  
  526.     "This is the size of the whole thing."
  527.     graphExtent := (startX - self minParentChildSpacing + self leafMargin) 
  528.                     @ ((self sideMargin)* 2 + maxH).
  529.     horizontal ifFalse: [graphExtent := graphExtent transpose]! !
  530.  
  531. CompositeView subclass: #GraphView
  532.     instanceVariableNames: 'composer viewBlock lineBlock labelBlock nodeViews labelViews '
  533.     classVariableNames: 'DefaultMenu UseCachingWrapperAsDefault '
  534.     poolDictionaries: ''
  535.     category: 'Tools-Grapher'!
  536. GraphView comment:
  537. 'A GraphView is used to draw a graphical representation of the relationships between objects.  The graphical relation is represented by a Graph.
  538.  
  539. Graphs have nodes, edges and (optionally) labels on edge.  In the graphical representation each node is represented by a view; the viewBlock is used to obtain a view object for a node.  Each label is also represented by a view; the labelBlock is used to build these.  It can be set to nil if there are no labels, or labels are not to be displayed (this is the default).
  540. The code used for rendering lines is also pluggable: see lineBlock.
  541.  
  542. The other aspect of a GraphView is the composer, which is an object that "knows" how to layout the views given the structure of the graph.  TreeComposers can do a reasonable job for trees; DAGComposers can do directed acyclic graphs.  Lots more composers will be provided one day!!
  543.  
  544. See the examples to get an idea how to use GraphViews.
  545.  
  546. Mario Wolczko, 1991
  547.  
  548. Instance variables:
  549.     composer    <GraphComposer>    the composer used to lay out the graph.
  550.     viewBlock    <Block of: Object to: VisualComponent>
  551.                 used the obtain a view for each node in the graph
  552.     lineBlock    <Block of: GraphicsContext to: (Block of: Point of: Point of: Object)>
  553.                 used to obtain a block which can display a line given the start point, end point and label.
  554.     labelBlock    <Block of: Object of: Object of: Object to: Object>
  555.                 used to obtain the object that will represent the label of an edge, given the node at the source of the edge, the destination node, and the label in the graph.
  556.     nodeViews    <IdentityDictionaryWithDefault from: Object to: VisualComponent>
  557.                 the cached output of viewBlock
  558.     labelViews    <DictionaryWithDefault from: Array of 3 Objects to: Object> the cached output of labelBlock
  559.  
  560. '!
  561.  
  562.  
  563. !GraphView methodsFor: 'control'!
  564.  
  565. defaultController
  566.     ^LowPriorityPluggableControllerWithMenu menu: DefaultMenu!
  567.  
  568. objectWantingControl
  569.     "If a component doesn't want control, try my controller."
  570.     | ctrlObject |
  571.     ^(ctrlObject := super objectWantingControl) isNil
  572.         ifTrue: [controller isControlWanted
  573.                     ifTrue: [controller]
  574.                     ifFalse: [nil]]
  575.         ifFalse: [ctrlObject]! !
  576.  
  577. !GraphView methodsFor: 'initialize-release
  578. '!
  579.  
  580. composer: c
  581.     composer := c!
  582.  
  583. initialize
  584.     super initialize.
  585.     "Default line rendering block; ignores labels."
  586.     self lineBlock: [ :gc | [ :start :end :label | gc displayLineFrom: start to: end]]!
  587.  
  588. labelBlock: aBlock
  589.     labelBlock := aBlock.
  590.     labelViews :=
  591.         DictionaryWithDefault newWithDefaultValueBlock:
  592.             [ :srcDestLbl | aBlock valueWithArguments: srcDestLbl]!
  593.  
  594. lineBlock: blockToBlock
  595.     "Set the lineBlock: this, when passed a graphics context, must return a block to display a line given the start point, end point and label.  ie:
  596.         blockToBlock: Block (GraphicsContext -> Block ( Point x Point x Object )).
  597.     See the default in the initialize method."
  598.     lineBlock := blockToBlock!
  599.  
  600. release
  601.     nodeViews do: [ :v | v release].
  602.     super release!
  603.  
  604. viewBlock: aBlock
  605.     viewBlock := aBlock.
  606.     nodeViews := IdentityDictionaryWithDefault newWithDefaultValueBlock: aBlock! !
  607.  
  608. !GraphView methodsFor: 'bounds accessing'!
  609.  
  610. preferredBounds
  611.     ^Rectangle origin: 0@0 extent: composer graphExtent! !
  612.  
  613. !GraphView methodsFor: 'composing'!
  614.  
  615. compose
  616.     composer
  617.         graph: self model ;
  618.         views: nodeViews ;
  619.         extentBlock: [ :nodeView | nodeView preferredBounds extent].
  620.     labelBlock isNil ifFalse: [composer labels: labelViews].
  621.     composer
  622.         compose ;
  623.         nodeViewsAndPositionsDo: [ :nodeView :position | self add: nodeView at: position] ;
  624.         labelsAndPositionsDo: [ :label :position | self add: label at: position]!
  625.  
  626. composeAgain
  627.     "Use this if the graph changes."
  628.     self removeAllComponents.
  629.     self removeUnneededViews.
  630.     self compose.
  631.     self newBounds!
  632.  
  633. recompose
  634.     "Use this if the graph hasn't changed, but the positions have."
  635.     self removeAllComponents.
  636.     composer compose ;
  637.         nodeViewsAndPositionsDo: [ :nodeView :position | self add: nodeView at: position] ;
  638.         labelsAndPositionsDo: [ :label :position | self add: label at: position].
  639.     self newBounds! !
  640.  
  641. !GraphView methodsFor: 'displaying'!
  642.  
  643. displayLinesOn: aGraphicsContext
  644.     | lbl |
  645.     lbl := lineBlock value: aGraphicsContext.
  646.     composer linesDo: lbl!
  647.  
  648. displayOn: aGraphicsContext
  649.     self displayLinesOn: aGraphicsContext.
  650.     super displayOn: aGraphicsContext! !
  651.  
  652. !GraphView methodsFor: 'accessing'!
  653.  
  654. composer
  655.     ^composer! !
  656.  
  657. !GraphView methodsFor: 'updating'!
  658.  
  659. update
  660.     self recompose!
  661.  
  662. update: aspect
  663.     aspect == #composition ifTrue: [^self recompose].
  664.     aspect == #graph ifTrue: [^self composeAgain]! !
  665.  
  666. !GraphView methodsFor: 'private'!
  667.  
  668. newBounds
  669.     self invalidateRectangle: self preferredBounds.
  670.     self changedPreferredBounds: nil!
  671.  
  672. removeAllComponents
  673.     components := OrderedCollection new.
  674.     self invalidateRectangle: self preferredBounds!
  675.  
  676. removeUnneededViews
  677.     "Remove node and label views for nodes that no longer form part of the graph."
  678.     nodeViews keys do: [ :node |
  679.         (self model includes: node) ifFalse: [nodeViews removeKey: node]].
  680.     labelBlock isNil ifFalse:
  681.         [labelViews keys do: [ :srcDestLbl |
  682.             ((self model includes: (srcDestLbl at: 2)) 
  683.             and: [self model includes: (srcDestLbl at: 2)])
  684.                 ifFalse: [labelViews removeKey: srcDestLbl]]]! !
  685. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  686.  
  687. GraphView class
  688.     instanceVariableNames: ''!
  689.  
  690.  
  691. !GraphView class methodsFor: 'examples'!
  692.  
  693. example1
  694.     "This demonstrates the basics"
  695.     "GraphView example1"
  696.     self
  697.         openOn: RootedGraph exampleDAG
  698.         composer: ((DAGComposer new) horizontal ; margins: 30 ; yourself)
  699.         viewBlock: self defaultViewBlock
  700.         label: 'silly example'!
  701.  
  702. example1b
  703.     "As example1, but the composer is chosen automatically."
  704.     "GraphView example1b"
  705.     self
  706.         openOn: RootedGraph exampleDAG
  707.         label: 'silly example'!
  708.  
  709. example2
  710.     "A small tree, no frills."
  711.     "GraphView example2"
  712.     self
  713.         openOn: RootedGraph exampleSmallTree
  714.         composer: ((TreeComposer new) vertical ; margins: 30 ; yourself)
  715.         viewBlock: self defaultViewBlock
  716.         label: 'small tree'!
  717.  
  718. example3
  719.     "A huge tree.  On some platforms this may be too big to handle."
  720.     "GraphView example3"
  721.     "Beware: this is a BIG tree!!"
  722.     self
  723.         openOn: RootedGraph exampleImplicitLargeTree
  724.         composer: ((TreeComposer new) margins: 30 ; yourself)
  725.         viewBlock: self defaultViewBlock
  726.         label: 'The whole class hierarchy!!'!
  727.  
  728. example4
  729.     "This is a test of the compatibility stuff.
  730.     Each node has an attached menu."
  731.     "GraphView example4"
  732.  
  733.     GraphView
  734.         openOn: (OrderedCollection with: Number)
  735.         label: 'Number hierarchy'
  736.         format: #()
  737.         menu: (PopUpMenu labels: 'inspect' values: #(#inspect ))
  738.         childrenMsg: #subclasses
  739.         labelMsg: #printString!
  740.  
  741. example5
  742.     "A small forest (two trees).  More like a glade, really."
  743.     "GraphView example5"
  744.     self
  745.         openOn: RootedGraph exampleForest
  746.         composer: ((TreeComposer new) margins: 30 ; yourself)
  747.         viewBlock: self defaultViewBlock
  748.         label: 'views and controllers'!
  749.  
  750. example5b
  751.     "Two trees, side by side."
  752.     "GraphView example5b"
  753.     | tree1 tree2 view1 view2 container topView |
  754.     tree1 := (RootedGraph unordered) roots: (Set with: View) children: [ :class | class subclasses].
  755.     tree2 := (RootedGraph unordered) roots: (Set with: Controller) children: [ :class | class subclasses].
  756.     view1 :=  self
  757.                 viewOn: tree1
  758.                 composer: ((TreeComposer new) margins: 20 ; yourself).
  759.     view2 :=  self
  760.                 viewOn: tree2
  761.                 composer: ((TreeComposer new) margins: 20 ; yourself).
  762.     container := CompositePart new.
  763.     container add: view1 borderedIn: (0@0 extent: 0.5@1).
  764.     container add: view2 borderedIn: (0.5@0 extent: 0.5@1).
  765.     topView := ScheduledWindow new.
  766.     topView
  767.         component: container;
  768.         minimumSize: 300@150;
  769.         open!
  770.  
  771. example6
  772.     "This tree has labels the edges between classes with the category."
  773.     "GraphView example6"
  774.     self
  775.         openOn: RootedGraph exampleSmallLabelledTree
  776.         composer: ((TreeComposer new)
  777.                         horizontal ;
  778.                         minParentChildSpacing: 200 ;
  779.                         minSiblingSpacing: 50 ;
  780.                         margins: 30 ;
  781.                         centeredTextLabels ;
  782.                         yourself)
  783.         viewBlock: self defaultViewBlock
  784.         labelBlock: [ :fromNode :toNode :label | ComposedText withText: label asString]
  785.         label: 'small tree'!
  786.  
  787. example7
  788.     "This tree can be grown or shrunk, according to the menu on each node."
  789.     "GraphView example7"
  790.     | roots graph |
  791.     roots := Set with: Collection.
  792.     graph := RootedGraph ordered.
  793.     graph roots: roots copy.
  794.     self
  795.         openOn: graph
  796.         composer: ((TreeComposer new)
  797.                         horizontal ;
  798.                         minParentChildSpacing: 20 ;
  799.                         minSiblingSpacing: 20 ;
  800.                         margins: 20 ;
  801.                         yourself)
  802.         viewBlock: [ :class | self expandingClassView: class graph: graph]
  803.         label: 'dynamic tree'!
  804.  
  805. example8
  806.     "This is another tree with labels (the type of class)."
  807.     "GraphView example8"
  808.     self
  809.         openOn: RootedGraph exampleSmallLabelledTree2
  810.         composer: ((TreeComposer new)
  811.                         horizontal ;
  812.                         minParentChildSpacing: 100 ;
  813.                         minSiblingSpacing: 20 ;
  814.                         margins: 30 ;
  815.                         centeredTextLabels ;
  816.                         yourself)
  817.         viewBlock: self defaultViewBlock
  818.         labelBlock: [ :fromNode :toNode :label | ComposedText withText: label asString]
  819.         label: 'classes and types'!
  820.  
  821. example8b
  822.     "As example8, but the labels are interpreted as line thicknesses."
  823.     "GraphView example8b"
  824.     self
  825.         openOn: RootedGraph exampleMediumLabelledTree
  826.         composer: ((TreeComposer new)
  827.                         horizontal ;
  828.                         minParentChildSpacing: 20 ;
  829.                         minSiblingSpacing: 5 ;
  830.                         margins: 30 ;
  831.                         yourself)
  832.         viewBlock: self defaultViewBlock
  833.         labelBlock: [ :fromNode :toNode :label | label]
  834.         lineBlock:
  835.             [ :gc |
  836.                 [ :start :end :label | 
  837.                     gc lineWidth: 
  838.                         (label = #normal
  839.                             ifTrue: [1]
  840.                             ifFalse: [label = #variable ifTrue: [2] ifFalse: [3]]).
  841.                     gc displayLineFrom: start to: end]]
  842.         label: 'classes and types'!
  843.  
  844. example8c
  845.     "As example8b, but the labels are interpreted as line types."
  846.     "GraphView example8c"
  847.  
  848.     (GraphicsContext canUnderstand: #displayDashLineFrom:to:dashLength:spaceLength:)
  849.         ifFalse: [^self error: 'You need either the ParcBench or Lancaster dashed line goodie for this to work.'].
  850.  
  851.     self
  852.         openOn: RootedGraph exampleMediumLabelledTree
  853.         composer: ((TreeComposer new)
  854.                         horizontal ;
  855.                         minParentChildSpacing: 20 ;
  856.                         minSiblingSpacing: 5 ;
  857.                         margins: 30 ;
  858.                         yourself)
  859.         viewBlock: self defaultViewBlock
  860.         labelBlock: [ :fromNode :toNode :label | label]
  861.         lineBlock:
  862.             [ :gc |
  863.                 [ :start :end :label || dashLength |
  864.                     label = #normal
  865.                         ifTrue: [gc displayLineFrom: start to: end]
  866.                         ifFalse: [dashLength := (label = #variable ifTrue: [2] ifFalse: [5]).
  867.                                 gc
  868.                                     displayDashLineFrom: start
  869.                                     to: end
  870.                                     dashLength: dashLength
  871.                                     spaceLength: dashLength]]]
  872.         label: 'classes and types'!
  873.  
  874. example8d
  875.     "As example8b, but the labels are interpreted as line colours."
  876.     "GraphView example8d"
  877.  
  878.     self
  879.         openOn: RootedGraph exampleMediumLabelledTree
  880.         composer: ((TreeComposer new)
  881.                         horizontal ;
  882.                         minParentChildSpacing: 20 ;
  883.                         minSiblingSpacing: 5 ;
  884.                         margins: 30 ;
  885.                         yourself)
  886.         viewBlock: self defaultViewBlock
  887.         labelBlock: [ :fromNode :toNode :label | label]
  888.         lineBlock:
  889.             [ :gc |
  890.                 [ :start :end :label || gc2 |
  891.                     gc2 := gc copy.
  892.                     gc2 paint: (label = #normal ifTrue: [ColorValue blue] ifFalse: [ColorValue red]).
  893.                     gc2 displayLineFrom: start to: end]]
  894.         label: 'classes and types'!
  895.  
  896. graphComponentsOfWindow: aWindow
  897.     "Draw a graph of the views and wrappers that make up a window."
  898.  
  899.     "Transcript cr ; show: 'Select a window...'.
  900.     Cursor crossHair showWhile: [Window currentWindow sensor waitButton].
  901.     GraphView graphComponentsOfWindow: Window currentWindow"
  902.  
  903.     GraphView
  904.         openOn: ((RootedGraph implicitCollection:
  905.                     [ :comp |
  906.                         (comp isKindOf: CompositePart)
  907.                             ifTrue: [comp components]
  908.                             ifFalse: [(comp respondsTo: #component)
  909.                                         ifTrue: [Array with: comp component]
  910.                                         ifFalse: [#()]]])
  911.                          buildFromRoots: (Array with: aWindow))
  912.         composer:  ((TreeComposer new) horizontal ; margins: 30 ; yourself)
  913.         viewBlock: [ :node || view |
  914.             view := ComponentView on: (ComposedText withText: node class name).
  915.             view model: node.
  916.             view controller:
  917.                 (PluggableControllerWithMenu menu:
  918.                     (PopUpMenu labels: 'inspect' values: #(#inspect))).
  919.             SimpleBorderedWrapper on: view]
  920.         label: 'tree of window components'! !
  921.  
  922. !GraphView class methodsFor: 'instance creation'!
  923.  
  924. model: graph composer: aComposer
  925.     "Build a GraphView on the graph.  Use aComposer to lay out the graph"
  926.     ^self model: graph composer: aComposer viewBlock: self defaultViewBlock labelBlock: nil!
  927.  
  928. model: graph composer: aComposer viewBlock: aBlock
  929.     "Build a GraphView on the graph.  Use aComposer to lay out the graph.  Use aBlock with each graph node to build a view on that node."
  930.     ^self model: graph composer: aComposer viewBlock: aBlock labelBlock: nil!
  931.  
  932. model: graph composer: aComposer viewBlock: aBlock labelBlock: lblBlock
  933.     "Build a GraphView on the graph.  Use aComposer to lay out the graph.  Use aBlock with each graph node to build a view on that node.  Use lblBlock with each edge label to build a view on that label."
  934.     ^self
  935.         model: graph
  936.         composer: aComposer
  937.         viewBlock: aBlock
  938.         labelBlock: lblBlock
  939.         lineBlock: nil!
  940.  
  941. model: graph composer: aComposer viewBlock: aBlock labelBlock: lblBlock lineBlock: lineBlock
  942.     "Build a GraphView on the graph.  Use aComposer to lay out the graph.  Use aBlock with each graph node to build a view on that node.  Use lblBlock with each edge label to build a view on that label.  Use lineBlock (if not nil) to render lines."
  943.     | view |
  944.     view := self model: graph.
  945.     view composer: aComposer.
  946.     view viewBlock: aBlock.
  947.     view labelBlock: lblBlock.
  948.     lineBlock notNil ifTrue: [view lineBlock: lineBlock].
  949.     view compose.
  950.     ^view!
  951.  
  952. openOn: graph composer: aComposer label: label
  953.     "Open a ScheduledWindow labelled with label containing a GraphView viewing the graph.  Use aComposer to lay out the graph.  Assume that each node and label should be displayed by sending it printString."
  954.     self
  955.         openOn: graph
  956.         composer: aComposer 
  957.         viewBlock: self defaultViewBlock
  958.         labelBlock: [ :from :to :lbl | ComposedText withText: lbl printString]
  959.         label: label!
  960.  
  961. openOn: graph composer: aComposer viewBlock: aBlock label: label
  962.     "Open a ScheduledWindow labelled with label containing a GraphView viewing the graph.  Use aComposer to lay out the graph.  Use aBlock with each graph node to build a view on that node."
  963.     self openOn: graph composer: aComposer viewBlock: aBlock labelBlock: nil label: label!
  964.  
  965. openOn: graph composer: aComposer viewBlock: aBlock labelBlock: lblBlock label: label
  966.     "Open a ScheduledWindow labelled with label containing a GraphView viewing the graph.  Use aComposer to lay out the graph.  Use aBlock with each graph node to build a view on that node.  Use lblBlock with each edge label to build a view on that label."
  967.     self
  968.         openOn: graph
  969.         composer: aComposer
  970.         viewBlock: aBlock
  971.         labelBlock: lblBlock
  972.         lineBlock: nil
  973.         label: label!
  974.  
  975. openOn: graph composer: aComposer viewBlock: aBlock labelBlock: lblBlock lineBlock: lineBlock label: label
  976.     "Open a ScheduledWindow labelled with label containing a GraphView viewing the graph.  Use aComposer to lay out the graph.  Use aBlock with each graph node to build a view on that node.  Use lblBlock with each edge label to build a view on that label.  Use lineBlock to render the lines (see lineBlock: instance method)."
  977.     | w extent |
  978.     w := self
  979.             windowOn: graph
  980.             composer: aComposer
  981.             viewBlock: aBlock
  982.             labelBlock: lblBlock
  983.             lineBlock: lineBlock.
  984.     w label: label.
  985.     "Try to open a window to show the whole graph."
  986.     extent := aComposer graphExtent
  987.                 + (LookPreferences markerThickness
  988.                     @ LookPreferences markerThickness).
  989.     extent := extent min: (Screen default bounds extent - (100@100)). 
  990.     w openWithExtent: extent!
  991.  
  992. openOn: graph label: label
  993.     "Open a ScheduledWindow labelled with label containing a GraphView viewing the graph.  Use a default composer to lay out the graph.  Assume that each node and label should be displayed by sending it printString."
  994.     self
  995.         openOn: graph
  996.         composer: graph defaultComposer 
  997.         viewBlock: self defaultViewBlock
  998.         labelBlock: [ :from :to :lbl | ComposedText withText: lbl printString]
  999.         label: label!
  1000.  
  1001. viewOn: graph composer: aComposer
  1002.     "Build a scrolling view containing a GraphView viewing the graph.  Use aComposer to lay out the graph."
  1003.     ^self
  1004.         viewOn: graph
  1005.         composer: aComposer
  1006.         viewBlock: self defaultViewBlock
  1007.         labelBlock: nil!
  1008.  
  1009. viewOn: graph composer: aComposer viewBlock: aBlock
  1010.     "Build a scrolling view containing a GraphView viewing the graph.  Use aComposer to lay out the graph.  Use aBlock with each graph node to build a view on that node."
  1011.     ^self
  1012.         viewOn: graph
  1013.         composer: aComposer
  1014.         viewBlock: aBlock
  1015.         labelBlock: nil!
  1016.  
  1017. viewOn: graph composer: aComposer viewBlock: aBlock labelBlock: lblBlock
  1018.     "Build a scrolling view containing a GraphView viewing the graph.  Use aComposer to lay out the graph.  Use aBlock with each graph node to build a view on that node.  Use lblBlock with each label to build a view on that label."
  1019.     ^self
  1020.         viewOn: graph
  1021.         composer: aComposer
  1022.         viewBlock: aBlock
  1023.         labelBlock: lblBlock
  1024.         lineBlock: nil!
  1025.  
  1026. viewOn: graph composer: aComposer viewBlock: aBlock labelBlock: lblBlock lineBlock: lineBlock
  1027.     "Build a scrolling view containing a GraphView viewing the graph.  Use aComposer to lay out the graph.  Use aBlock with each graph node to build a view on that node.  Use lblBlock with each label to build a view on that label.  Use lineBlock to render the lines (see lineBlock: instance method)."
  1028.     | view decorator |
  1029.     view := self
  1030.                 model: graph
  1031.                 composer: aComposer
  1032.                 viewBlock: aBlock
  1033.                 labelBlock: lblBlock
  1034.                 lineBlock: lineBlock.
  1035.     UseCachingWrapperAsDefault ifTrue: [view := CachingWrapper on: view].
  1036.      decorator := LookPreferences edgeDecorator onScroller: (PanningWrapper on: view).
  1037.     decorator useHorizontalScrollBar.
  1038.     ^decorator!
  1039.  
  1040. windowOn: graph composer: aComposer
  1041.     "Build a ScheduledWindow containing a GraphView viewing the graph.  Use aComposer to lay out the graph.  Assume that each node and label should be displayed by sending it printString."
  1042.     ^self 
  1043.         windowOn: graph
  1044.         composer: aComposer
  1045.         viewBlock: self defaultViewBlock
  1046.         labelBlock: [ :from :to :label | ComposedText withText: label printString]!
  1047.  
  1048. windowOn: graph composer: aComposer viewBlock: aBlock
  1049.     "Build a ScheduledWindow containing a GraphView viewing the graph.  Use aComposer to lay out the graph.  Use aBlock with each graph node to build a view on that node."
  1050.     ^self
  1051.         windowOn: graph
  1052.         composer: aComposer
  1053.         viewBlock: aBlock
  1054.         labelBlock: nil!
  1055.  
  1056. windowOn: graph composer: aComposer viewBlock: aBlock labelBlock: lblBlock
  1057.     "Build a ScheduledWindow containing a GraphView viewing the graph.  Use aComposer to lay out the graph.  Use aBlock with each graph node to build a view on that node.  Use lblBlock with each label to build a view on that label."
  1058.     ^self
  1059.         windowOn: graph
  1060.         composer: aComposer
  1061.         viewBlock: aBlock
  1062.         labelBlock: lblBlock
  1063.         lineBlock: nil!
  1064.  
  1065. windowOn: graph composer: aComposer viewBlock: aBlock labelBlock: lblBlock lineBlock: lineBlock
  1066.     "Build a ScheduledWindow containing a GraphView viewing the graph.  Use aComposer to lay out the graph.  Use aBlock with each graph node to build a view on that node.  Use lblBlock with each label to build a view on that label.  Use lineBlock to render the lines (see lineBlock: instance method)."
  1067.     | topView view |
  1068.     view := self
  1069.                 viewOn: graph
  1070.                 composer: aComposer
  1071.                 viewBlock: aBlock
  1072.                 labelBlock: lblBlock
  1073.                 lineBlock: lineBlock.
  1074.     topView := ScheduledWindow new.
  1075.     topView component: view.
  1076.     ^topView! !
  1077.  
  1078. !GraphView class methodsFor: 'backward compatibility'!
  1079.  
  1080. openOn: roots label: labelString format: formatSymbols
  1081.     self openOn: roots label: labelString format: formatSymbols menu: nil!
  1082.  
  1083. openOn: roots label: labelString format: formatSymbols menu: aMenu
  1084.     self openOn: roots
  1085.         label: labelString
  1086.         format: formatSymbols
  1087.         menu: aMenu
  1088.         childrenMsg: #children
  1089.         labelMsg: #graphLabel!
  1090.  
  1091. openOn: roots label: label format: formatSymbols menu: aMenu childrenMsg: childrenMsg labelMsg: labelMsg
  1092.     | composer graph |
  1093.     graph := (RootedGraph implicitCollection: [ :n | n perform: childrenMsg]) buildFromRoots: roots.
  1094.     composer := graph defaultComposer.
  1095.     (formatSymbols includes: #vertical) ifTrue: [composer vertical].
  1096.     (formatSymbols includes: #horizontal) ifTrue: [composer horizontal].
  1097.     self
  1098.         openOn: graph
  1099.         composer: composer
  1100.         viewBlock: [ :node || view wrapper |
  1101.             view := ComposedText withText: (node perform: labelMsg).
  1102.             aMenu notNil 
  1103.                 ifTrue: 
  1104.                     [view := ComponentView on: view.
  1105.                     view model: node.
  1106.                     view controller: (PluggableControllerWithMenu menu: aMenu)].
  1107.             wrapper := SimpleBorderedWrapper on: view.
  1108.             wrapper]
  1109.         label: label! !
  1110.  
  1111. !GraphView class methodsFor: 'class initialization'!
  1112.  
  1113. flipBlock
  1114.     ^[ :m :v :c || o |
  1115.         o := v composer orientation.
  1116.         o == #horizontal
  1117.             ifTrue: [o := #vertical]
  1118.             ifFalse: [o == #vertical ifTrue: [o := #horizontal]].
  1119.         v composer orientation: o.
  1120.         v recompose]!
  1121.  
  1122. initialize
  1123.     "GraphView initialize"
  1124.     DefaultMenu := PopUpMenu labels: 'flip' values: (Array with: self flipBlock).
  1125.     UseCachingWrapperAsDefault := false! !
  1126.  
  1127. !GraphView class methodsFor: 'defaults'!
  1128.  
  1129. defaultViewBlock
  1130.     ^[ :node | SimpleBorderedWrapper on: (ComposedText withText: node printString)]!
  1131.  
  1132. dontUseCachingWrappers
  1133.     "GraphView dontUseCachingWrappers"
  1134.     UseCachingWrapperAsDefault := false!
  1135.  
  1136. useCachingWrappers
  1137.     "GraphView useCachingWrappers"
  1138.     "This doesn't work right under Windows-TM on large graphs (due to no fault of mine)."
  1139.     UseCachingWrapperAsDefault := true! !
  1140.  
  1141. !GraphView class methodsFor: 'examples-support'!
  1142.  
  1143. expandingClassView: class graph: graph
  1144.     "Build a view on class than expands or contracts graph in response to menu choices.
  1145.     The border of the class depends on whether the tree below that class is hidden or not.
  1146.  
  1147.     If this were a method in GraphView then graph would be the instance variable of the same name."
  1148.     | view |
  1149.     view := ComponentView on: (ComposedText withText: class name).
  1150.     view model: class.
  1151.     view controller:
  1152.         (PluggableControllerWithMenu menu:
  1153.             (PopUpMenu
  1154.                 labels: 'inspect\expand\expand all\contract' withCRs
  1155.                 values: (Array
  1156.                             with: #inspect
  1157.                             with: [ :m :v :c |    "expand"
  1158.                                 m subclasses do: [ :sc | graph addEdgeFrom: m to: sc].
  1159.                                 graph changed: #graph]
  1160.                                 "the next thing could be made more efficient..."
  1161.                             with: [ :m :v :c |    "expand all"
  1162.                                 m subclasses do: [ :sc | graph addEdgeFrom: m to: sc].
  1163.                                 m allSubclassesDo: [ :sc |
  1164.                                     sc subclasses do: [ :ssc | graph addEdgeFrom: sc to: ssc]].
  1165.                                 graph changed: #graph]
  1166.                             with: [ :m :v :c || node |    "contract"
  1167.                                 node := graph nodeFor: m.
  1168.                                 node isLeaf
  1169.                                     ifFalse:
  1170.                                         [graph removeAllFrom: node.
  1171.                                         graph changed: #graph]]))).
  1172.     ^SimpleBorderedWrapper
  1173.         on: view
  1174.         border:
  1175.             (class subclasses isEmpty
  1176.                 ifTrue: [self normalBorder]
  1177.                 ifFalse: [self fatBorder])!
  1178.  
  1179. fatBorder
  1180.     | b |
  1181.     b := LookPreferences defaultBorder copy.
  1182.     b setBorderWidth: 2.
  1183.     ^b!
  1184.  
  1185. normalBorder
  1186.     ^LookPreferences defaultBorder! !
  1187. GraphView initialize!
  1188.  
  1189.